home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE01 / TIPTRIX / MEMCLIP / MEMOCLIP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-05  |  2.2 KB  |  106 lines
  1. unit MemoClip;
  2.  
  3. { The following object give you access to the
  4.   clipboard format CF_TEXT as a TStringList with
  5.   the  Lines property, instead of the Text
  6.   property wich only work for small strings.
  7.  
  8.   To access it you must do a typecast via
  9.   with TMemoClipboard(ClipBoard) or
  10.   with ClipBoard as TMemoClipboard !
  11.  
  12.     -Mfg Stefc-
  13. }
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  19.   Forms, Dialogs, ClipBrd;
  20.  
  21. type
  22.   TMemoClipboard = class(TClipBoard)
  23.   private
  24.     function  GetLines: TStrings;
  25.     procedure SetLines(Value: TStrings);
  26.   public
  27.     property  AsLines: TStrings read GetLines write SetLines;
  28.   end;
  29.  
  30. implementation
  31.  
  32. { TMemoClipBoard }
  33.  
  34. procedure TMemoClipBoard.SetLines(Value:TStrings);
  35. var
  36.   Data    : THandle;
  37.   DataPtr : Pointer;
  38.   Stream  : TMemoryStream;
  39. begin
  40.   Open;
  41.   try
  42.     Stream := TMemoryStream.Create;
  43.     try
  44.       Value.SaveToStream(Stream);
  45.       Data := GlobalAlloc(GMEM_MOVEABLE, Stream.Size);
  46.       try
  47.         DataPtr := GlobalLock(Data);
  48.         try
  49.           hmemcpy(DataPtr, Stream.Memory, Stream.Size);
  50.           Clear;
  51.           SetClipboardData(CF_TEXT, Data);
  52.         finally
  53.           GlobalUnlock(Data);
  54.         end;
  55.       except
  56.         GlobalFree(Data);
  57.         raise;
  58.       end;
  59.     finally
  60.       Stream.Free;
  61.     end;
  62.   finally
  63.     Close;
  64.   end;
  65. end;
  66.  
  67. function TMemoClipBoard.GetLines: TStrings;
  68. var
  69.   Data    : THandle;
  70.   DataPtr : PChar;
  71.   Stream  : TStream;
  72. begin
  73.   Result:=nil;
  74.   Open;
  75.   try
  76.     Data := GetClipboardData(CF_TEXT);
  77.     if Data = 0 then Exit;
  78.     DataPtr := GlobalLock(Data);
  79.     try
  80.       Stream := TMemoryStream.Create;
  81.       try
  82.         Stream.Write(DataPtr^,StrLen(DataPtr));
  83.         Stream.Position := 0;
  84.         try
  85.           Result:=TStringList.Create;
  86.           Result.LoadFromStream(Stream);
  87.         except
  88.           Result.Free;
  89.           Result:=nil;
  90.         end;
  91.       finally
  92.         Stream.Free;
  93.       end;
  94.     finally
  95.       GlobalUnlock(Data);
  96.     end;
  97.   finally
  98.     Close;
  99.   end;
  100. end;
  101.  
  102. begin
  103.   Clipboard.Free;                   { Replace Clipboard with ourself }
  104.   Clipboard:=TMemoClipboard.Create;
  105. end.
  106.